home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 August / Macworld (1997-08).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / calc.tcl < prev    next >
Text File  |  1997-06-17  |  5KB  |  211 lines
  1.  
  2. ##########################################################################
  3. #                                                                         #
  4. #    Use    at your    own    risk. This is just a quick-and-dirty RPN stack         #
  5. #    calculator,    works on both decimal (signed and unsigned), hex         #
  6. #     integers, and floating point. I put it                                 #
  7. #    together for my    own    use, not yours,    but    feel free to use it    as         #
  8. #    long as    you    don't complain about what it doesn't do. Improvements,     #
  9. #    of course, are welcome.                                                 #
  10. #                                                                         #
  11. #    Operations:                                                             #
  12. #        +,-,*,/,|,&,%    Top    of stack is    'y', next is 'x'. Does x OP    y.     #
  13. #        ~                bitwise NOT                                         #
  14. #        ^                x eor y                                             #
  15. #        <                x << y                                             #
  16. #        >                x >> y                                             #
  17. #        c                change y's sign                                     #
  18. #        q                dup    y                                             #
  19. #        i                swap x and y                                     #
  20. #        m                switch decimal/hex modes                         #
  21. #        x                show current mode                                 #
  22. #        h,?                help                                             #
  23. #        <delete>        pop    stack                                         #
  24. #        <space>            enter number                                     #
  25. #                                                                         #
  26. #    The mode indicator indicates whether hex or dec is active.              #
  27. #    All calculations performed in signed decimal.                         #
  28. #                                                                         #
  29. ##########################################################################
  30.  
  31. set tcl_precision 17
  32.  
  33. proc calculator {} {
  34.     global tileLeft tileTop
  35.     if {[set ind [lsearch -exact [winNames] {* Calc *}]] >= 0} {
  36.         bringToFront {* Calc *}
  37.         return
  38.     }
  39.     new -g $tileLeft $tileTop 200 200 -n {* Calc *}
  40.     global winModes
  41.     set name [lindex [winNames] 0]
  42.     changeMode [set winModes($name) Calc]
  43.     catch {setWinInfo -w $name shell 1}
  44. }
  45.  
  46.  
  47. lappend modes Calc
  48. set modes [lsort $modes]
  49.  
  50. ascii 0x2b "binop +"    Calc
  51. ascii 0x2d "binop -"    Calc
  52. ascii 0x2a "binop *"    Calc
  53. ascii 0x2f "binop /"    Calc
  54. ascii 0x7c "binop |"    Calc
  55. ascii 0x5e "binop ^"    Calc
  56. ascii 0x26 "binop &"    Calc
  57. ascii 0x25 "binop %"    Calc
  58. ascii 0x3e "binop >>"    Calc
  59. ascii 0x3c "binop <<"    Calc
  60. ascii 0x7e "unaryop ~"     Calc
  61. ascii 0x63 "unaryop -"    Calc
  62. ascii 0x3f "editMark \"$HOME:Help:Manual\" Calculator -r" Calc
  63. ascii 0x68 "editMark \"$HOME:Help:Manual\" Calculator -r" Calc
  64. ascii 0x71 calcDup        Calc
  65. ascii 0x69 calcEx        Calc
  66. ascii 0x6d changeCalcMode    Calc
  67. ascii 0x78 "calcShow"    Calc
  68. ascii 0x20 calcEnter    Calc
  69. ascii 0x08 calcDel        Calc
  70.  
  71. set calcMode 3
  72.  
  73. proc changeCalcMode {} {
  74.     global calcMode
  75.     
  76.     goto [maxPos]
  77.     if {[getPos]} {
  78.         if {[lookAt [expr [getPos] - 1]] != "\r"} calcEnter
  79.         set nums {}
  80.         set t ""
  81.         foreach n [split [getText 0 [expr [maxPos] - 1]] "\r"] {
  82.             lappend nums [calcGet $n]
  83.         }
  84.         set calcMode [expr ($calcMode + 1) % 4]
  85.         foreach n $nums {
  86.             append t "[calcPut $n]\r"
  87.         }
  88.         replaceText 0 [maxPos] $t
  89.     } else {
  90.         set calcMode [expr ($calcMode + 1) % 4]
  91.     }
  92.     switch "$calcMode" {
  93.         0     {message "Signed decimal" }
  94.         1     {message "Unsigned decimal"}
  95.         2     {message "Unsigned hexadecimal"}
  96.         3     {message "Floating Point"}
  97.     }
  98. }
  99.  
  100.  
  101. proc calcShow {} {
  102.     global calcMode
  103.     switch "$calcMode" {
  104.         0     {message "Signed decimal" }
  105.         1     {message "Unsigned decimal"}
  106.         2     {message "Unsigned hexadecimal"}
  107.         3     {message "Floating Point"}
  108.     }
  109. }
  110.  
  111.  
  112. proc calcGet {in} {
  113.     global calcMode
  114.  
  115.     switch "$calcMode" {
  116.         0    {scan $in "%d" num; return $num}
  117.         1    {scan $in "%u" num; return $num}
  118.         2    {scan $in "%x" num; return $num}
  119.         3    {scan $in "%f" num; return $num}
  120.     }
  121.     error "Bad hex num '$in'"
  122. }
  123.  
  124.  
  125. proc calcPut {in} {
  126.     global calcMode
  127.  
  128.     if {$calcMode != 3} {
  129.         regexp {[0-9-]+} $in in
  130.     }
  131.     switch $calcMode {
  132.         0         {return [format "%10d" $in]}
  133.         1         {return [format "%10u" $in]}
  134.         2         {return [format "%10x" $in]}
  135.         3         {return [format "%17.6f" $in]}
  136.     }
  137. }
  138.  
  139.         
  140. proc binop {op} {
  141.     global calcMode
  142.     goto [maxPos]
  143.     if {[lookAt [expr [getPos] - 1]] != "\r"} calcEnter
  144.     set pos [lineStart [getPos]]
  145.     set st_y [lineStart [expr $pos - 1]]
  146.     set st_x [lineStart [expr $st_y - 1]]
  147.     if {$st_y == $st_x} { beep; return}
  148.     set res [eval expr [calcGet [getText $st_x $st_y]] $op [calcGet [getText $st_y $pos]]]
  149.     replaceText $st_x [maxPos] "[calcPut $res]\r"
  150. }
  151.  
  152.  
  153. proc unaryop {op} {
  154.     goto [maxPos]
  155.     
  156.     set pos [getPos]
  157.     set last [lineStart [expr [getPos] - 1]]
  158.     replaceText $last $pos [expr "[calcPut $op[calcGet [getText $last $pos]]]"] "\r"
  159. }
  160.  
  161.  
  162. proc calcEx {} {
  163.     goto [maxPos]
  164.     if {[lookAt [expr [getPos] - 1]] != "\r"} calcEnter
  165.     set pos [lineStart [getPos]]
  166.     set st_y [lineStart [expr $pos - 1]]
  167.     set st_x [lineStart [expr $st_y - 1]]
  168.     if {$st_y == $st_x} { beep; return}
  169.     replaceText $st_x [maxPos] "[getText $st_y $pos][getText $st_x $st_y]"
  170. }
  171.  
  172.  
  173. proc calcEnter {} {
  174.     global calcMode
  175.     goto [maxPos]
  176.     switch "$calcMode" {
  177.         0     {set ex {[0-9-]+$}}
  178.         1     {set ex {[0-9]+$}}
  179.         2     {set ex {[0-9a-f]+$}}
  180.         3     {set ex {[0-9.-]+$}}
  181.     } 
  182.     if {[regexp $ex [getText [lineStart [getPos]] [getPos]] num]} {
  183.         set num [calcGet $num]
  184.         replaceText [lineStart [getPos]] [getPos] [calcPut $num] "\r"
  185.     } else {
  186.         beep
  187.         beginningOfLine
  188.         killLine
  189.     }
  190. }
  191.  
  192. proc calcDel {} {
  193.     goto [maxPos]
  194.     if {[lookAt [expr [getPos] - 1]] == "\r"} {
  195.         deleteText [lineStart [expr [getPos] - 1]] [getPos]
  196.     } else {
  197.         backSpace
  198.     }
  199. }
  200.  
  201. proc calcDup {} {
  202.     goto [maxPos]
  203.     if {[lookAt [expr [getPos] - 1]] != "\r"} calcEnter
  204.     set to [lineStart [getPos]]
  205.     set from [lineStart [expr $to - 1]]
  206.     set t [getText $from $to]
  207.     insertText $t
  208. }
  209.  
  210.  
  211.